home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1998 / MacHack 1998.toast / The Hacks! / PCA Icon Arranger ƒ / PCoordAE.p < prev    next >
Encoding:
Text File  |  1998-06-20  |  8.9 KB  |  308 lines  |  [TEXT/PJMM]
  1. unit PCoordAE;
  2.  
  3. interface
  4.  
  5.     uses
  6. {$ifc not undefined THINK_PASCAL}
  7.         InterfacesUI, 
  8. {$endc}
  9.         Notification, Processes, AppleTalk, PPCToolBox, EPPC, AppleEvents, { All this is necessary for Apple Events... }
  10.         MathDeclarations, PCoord3;
  11.  
  12.     procedure InstallPCoordHandlers;
  13.  
  14. implementation
  15.  
  16. { must do this to preserve source code compatibility with CW }
  17. {$ifc not undefined THINK_PASCAL}
  18.     type
  19.         AEEventHandlerUPP = UniversalProcPtr;
  20.         AEEventHandlerProcPtr = ProcPtr;
  21.     function NewAEEventHandlerProc (userRoutine: AEEventHandlerProcPtr): AEEventHandlerUPP;
  22.     inline
  23.         $2E9F;
  24. {$endc}
  25.  
  26.     const
  27.         kSignature = 'Rshl';
  28.         evtInit = 'Init';
  29.         evtAdd = 'AddO';
  30.         evtGet = 'GetC';
  31.         evtComp = 'comp';
  32.  
  33.     var
  34.         theData, resultMatrix: TMatrixPtr;
  35.         numRows: TInteger;
  36.  
  37.  
  38.     function Initialize (var theAppleEvent: AppleEvent;
  39.                                     var reply: AppleEvent;
  40.                                     handlerRefCon: LongInt): OSErr;
  41.         var
  42.             err: OSErr;
  43.             rows, cols: Integer;
  44.             docList: AEDescList;
  45.             itemsInList: LongInt;
  46.             actualSize: Size;
  47.             keywd: AEKeyword;
  48.             returnedType: DescType;
  49.     begin
  50. { If there is data, erase it }
  51.         if theData <> nil then
  52.             DisposeMatrix(theData);
  53.         if resultMatrix <> nil then
  54.             DisposeMatrix(resultMatrix);
  55.  
  56.  
  57.         numRows := 0;
  58.  
  59.         { Decode the event we just received }
  60.         err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList);
  61.         err := AECountItems(docList, itemsInList);
  62.         if (itemsInList = 2) and (err = noErr) then begin
  63.             err := AEGetNthPtr(docList, 1, typeSMInt, keywd, returnedType, @rows, SizeOf(rows), actualSize);
  64.             if err = noErr then
  65.                 err := AEGetNthPtr(docList, 2, typeSMInt, keywd, returnedType, @cols, SizeOf(cols), actualSize);
  66.             if err = noErr then
  67.                 if not NewMatrix(theData, rows, cols, false, false) then
  68.                     err := memFullErr;
  69.         end; { itemsInList =2 }
  70.  
  71.         Initialize := err;
  72.     end; { Initialize }
  73.  
  74.  
  75.     function AddObject (var theAppleEvent: AppleEvent;
  76.                                     var reply: AppleEvent;
  77.                                     handlerRefCon: LongInt): OSErr;
  78.         var
  79.             err: OSErr;
  80.             myReal: TReal;
  81.             docList: AEDescList;
  82.             index, itemsInList: LongInt;
  83.             actualSize: Size;
  84.             keywd: AEKeyword;
  85.             returnedType: DescType;
  86.     begin
  87.         { Decode the event we just received }
  88.         err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList);
  89.         err := AECountItems(docList, itemsInList);
  90.         if (itemsInList > 0) and (err = noErr) then begin { fill new row of the data }
  91.             numRows := numRows + 1;
  92.             for index := 1 to itemsInList do begin
  93.                 if index > theData^.p then { oops! too big! }
  94.                     err := -1;
  95.                 if err = noErr then { coerce to a double }
  96.                     err := AEGetNthPtr(docList, index, typeFloat, keywd, returnedType, @myReal, SizeOf(myReal), actualSize);
  97.                 if err = noErr then begin { do something with the number }
  98.                     SetElement(theData, numRows, index, myReal);
  99.                 end; { if noErr }
  100.             end; { for index }
  101.         end; { itemsInList > 0 }
  102.         AddObject := err;
  103.     end; { AddObject }
  104.  
  105.     function GetOneCoordinate (var theAppleEvent: AppleEvent;
  106.                                     var reply: AppleEvent;
  107.                                     handlerRefCon: LongInt): OSErr;
  108.         var
  109.             err: OSErr;
  110.             row, col: Integer;
  111.             myReal: TReal;
  112.             docList: AEDescList;
  113.             itemsInList: LongInt;
  114.             actualSize: Size;
  115.             keywd: AEKeyword;
  116.             returnedType: DescType;
  117.     begin
  118.         { Decode the event we just received }
  119.         err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList);
  120.         err := AECountItems(docList, itemsInList);
  121.         if (itemsInList = 2) and (err = noErr) then begin
  122.             err := AEGetNthPtr(docList, 1, typeSMInt, keywd, returnedType, @row, SizeOf(row), actualSize);
  123.             if err = noErr then
  124.                 err := AEGetNthPtr(docList, 2, typeSMInt, keywd, returnedType, @col, SizeOf(col), actualSize);
  125.             if err = noErr then begin { return the row/col element of result matrix in the reply appleevent }
  126.                 myReal := -1;
  127.                 if ((row > 0) and (row <= resultMatrix^.n)) and ((col > 0) and (col <= resultMatrix^.p)) then
  128.                     myReal := GetElement(resultMatrix, row, col);
  129.                 err := AEPutParamPtr(reply, keyDirectObject, typeFloat, @myReal, SizeOf(myReal));
  130.             end;
  131.         end; { itemsInList =2 }
  132.         GetOneCoordinate := err;
  133.     end; { GetOneCoordinate }
  134.  
  135.  
  136. { Compute the euclidean distance between all objects of source }
  137.     procedure EuclideanDistance (source: TMatrixPtr;
  138.                                     var result: TMatrixPtr);
  139.         var
  140.             i, j, nbObjets: TInteger;
  141.             val: TReal;
  142.  
  143.         function D01 (LIGNE1, LIGNE2: TInteger): TReal;
  144.             var
  145.                 COLONNE: INTEGER;
  146.                 X, Y, XX: TReal;
  147.         begin
  148.             XX := 0;
  149.             for COLONNE := 1 to source^.p do begin
  150.                 X := GetElement(source, Ligne1, COLONNE);
  151.                 Y := GetElement(source, Ligne2, COLONNE);
  152.                 XX := XX + SQR(X - Y);
  153.             end;
  154.             D01 := SQRT(XX);
  155.         end; (* FIN D01 *)
  156.  
  157.     begin
  158.         result := nil;
  159.         nbObjets := source^.n;
  160.         if NewMatrix(result, nbObjets, nbObjets, false, false) then begin { square matrix }
  161.             for i := 1 to nbObjets do begin
  162.                 for j := i + 1 to nbObjets do begin
  163.                     val := D01(i, j);
  164.                     SetElement(result, i, j, val);
  165.                     SetElement(result, j, i, val); { set lower triangular, for symmetry }
  166.                 end;
  167.                 SetElement(result, i, i, 0); { set diagonal to zero for completion's sake }
  168.             end;
  169.         end;
  170.     end; { EuclideanDistance }
  171.  
  172.  procedure CentrerEtReduire (var m: TMatrixPtr;
  173.        c: TInteger);
  174.   var
  175.    moyenne, ecartType, somme, sommeCarres, val: TReal;
  176.    i: TInteger;
  177.  begin
  178.   Assert(m <> nil);
  179.   if (c > 0) and (c <= m^.p) then begin
  180.    somme := 0;
  181.    sommeCarres := 0;
  182.    for i := 1 to m^.n do begin
  183.     val := GetElement(m, i, c);
  184.     somme := somme + val;
  185.     sommeCarres := sommeCarres + (val * val);
  186.    end; { for i }
  187.  
  188.    moyenne := somme / m^.n;
  189.    ecartType := Sqrt((sommeCarres - (somme * somme) / m^.n) / (m^.n - 1));
  190.    if ecartType = 0 then
  191.        ecartType := 1;
  192.  
  193.    for i := 1 to m^.n do begin
  194.     val := GetElement(m, i, c);
  195.     val := (val - moyenne) / ecartType;
  196.     SetElement(m, i, c, val);
  197.    end; { for i }
  198.   end;
  199.  end; { CentrerEtReduire }
  200.  
  201.     function Compute (var theAppleEvent: AppleEvent;
  202.                                     var reply: AppleEvent;
  203.                                     handlerRefCon: LongInt): OSErr;
  204.         var
  205.             euclideanMatrix: TMatrixPtr;
  206.             docList: AEDescList;
  207.             itemsInList: LongInt;
  208.             keywd: AEKeyword;
  209.             err: OSErr;
  210.             i, numDim, width, height: Integer;
  211.             actualSize: Size;
  212.             returnedType: DescType;
  213.             x, y, xmin, xmax, ymin, ymax, xScale, yScale: TReal;
  214.     begin
  215.         err := noErr;
  216.         euclideanMatrix := nil;
  217.  
  218.         { Decode the event we just received }
  219.         err := AEGetParamPtr(theAppleEvent, keyDirectObject, typeSMInt, returnedType, @numDim, SizeOf(numDim), actualSize);
  220.         err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList);
  221.         err := AECountItems(docList, itemsInList);
  222.         if (itemsInList = 3) and (err = noErr) then begin
  223.             err := AEGetNthPtr(docList, 1, typeSMInt, keywd, returnedType, @numDim, SizeOf(numDim), actualSize);
  224.             if err = noErr then
  225.                 err := AEGetNthPtr(docList, 2, typeSMInt, keywd, returnedType, @width, SizeOf(width), actualSize);
  226.             if err = noErr then
  227.                 err := AEGetNthPtr(docList, 3, typeSMInt, keywd, returnedType, @height, SizeOf(height), actualSize);
  228.         end; { itemsInList =2 }
  229.  
  230.         { Standardize the columns so they are dimensionally homogeneous }
  231.         
  232.         for i := 1 to theData^.p do
  233.             CentrerEtReduire(theData, i);
  234.  
  235.         EuclideanDistance(theData, euclideanMatrix);
  236.  
  237.         if (numDim <= theData^.p) and (err = noErr) then
  238.             resultMatrix := GetCoords(euclideanMatrix, true, numDim); { distance matrix, numDim dimensions }
  239.         if resultMatrix = nil then
  240.             err := memFullErr;
  241.  
  242.         if (err = noErr) and (width > 0) and (height > 0) then begin { scale the coordinates in the width/height }
  243.             { find mins and maxs }
  244.             xmin := 10E60; { some large value }
  245.             ymin := 10E60;
  246.             xmax := -10E60;
  247.             ymax := -10E60;
  248.             for i := 1 to resultMatrix^.n do begin 
  249.                 x := GetElement(resultMatrix, i, 1);
  250.                 y := GetElement(resultMatrix, i, 2);
  251.                 if xmin > x then
  252.                     xmin := x;
  253.                 if ymin > y then
  254.                     ymin := y;
  255.                 if xmax < x then
  256.                     xmax := x;
  257.                 if ymax < y then
  258.                     ymax := y;
  259.             end; { for i }
  260.             
  261.             { scale factors }
  262.             xScale := abs(xmax - xmin) / width;
  263.             yScale := abs(ymax - ymin) / height;
  264.             
  265.             { actual scaling }
  266.             for i := 1 to resultMatrix^.n do begin 
  267.                 x := GetElement(resultMatrix, i, 1);
  268.                 y := GetElement(resultMatrix, i, 2);
  269.                 SetElement(resultMatrix, i, 1, x / xScale);
  270.                 SetElement(resultMatrix, i, 2, y / yScale);
  271.             end; { for i }
  272.         
  273.         end; { scaling }
  274.  
  275.         DisposeMatrix(euclideanMatrix);
  276.  
  277.         Compute := err;
  278.  
  279. { We now have a valid resultMatrix }
  280.     end; { Compute }
  281.  
  282.  
  283.     procedure InstallPCoordHandlers;
  284.         var
  285.             err: OSErr;
  286.             myHandlerUPP: AEEventHandlerUPP;
  287.     begin
  288.  
  289.         theData := nil; { no data yet! }
  290.         resultMatrix := nil; { same }
  291.         numRows := 0;
  292.  
  293.         myHandlerUPP := NewAEEventHandlerProc(@Initialize);
  294.         err := AEInstallEventHandler(kSignature, evtInit, myHandlerUPP, 0, False);
  295.  
  296.         myHandlerUPP := NewAEEventHandlerProc(@AddObject);
  297.         err := AEInstallEventHandler(kSignature, evtAdd, myHandlerUPP, 0, False);
  298.  
  299.         myHandlerUPP := NewAEEventHandlerProc(@GetOneCoordinate);
  300.         err := AEInstallEventHandler(kSignature, evtGet, myHandlerUPP, 0, False);
  301.  
  302.         myHandlerUPP := NewAEEventHandlerProc(@Compute);
  303.         err := AEInstallEventHandler(kSignature, evtComp, myHandlerUPP, 0, False);
  304.  
  305.     end;
  306.  
  307.  
  308. end.{ unit }